home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / NUMBERS.SWG / 0030_MSBIN to IEEE.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-28  |  9KB  |  303 lines
  1. {===========================================================================
  2. Date: 10-09-93 (23:23)
  3. From: J.P. Ritchey
  4. Subj: MSBIN to IEEE
  5. ---------------------------------------------------------------------------
  6. GE>         Does anyone have any code for Converting MSBIN format
  7. GE>         numbers into IEEE?  }
  8.  
  9. {$A-,B-,D-,E+,F-,I-,L-,N+,O-,R-,S-,V-}
  10. unit BFLOAT;
  11. (*
  12.             MicroSoft Binary Float to IEEE format Conversion
  13.                     Copyright (c) 1989 J.P. Ritchey
  14.                             Version 1.0
  15.  
  16.          This software is released to the public domain.  Though
  17.          tested, there could be some errors.  Any reports of bugs
  18.          discovered would be appreciated. Send reports to
  19.                  Pat Ritchey     Compuserve ID 72537,2420
  20. *)
  21. interface
  22.  
  23. type
  24.   bfloat4 = record
  25.     { M'Soft single precision }
  26.     mantissa : array[5..7] of byte;
  27.     exponent : byte;
  28.     end;
  29.  
  30.   Bfloat8 = record
  31.     { M'Soft double precision }
  32.     mantissa : array[1..7] of byte;
  33.     exponent : byte;
  34.     end;
  35.  
  36.  
  37. Function Bfloat4toExtended(d : bfloat4) : extended;
  38. Function Bfloat8toExtended(d : Bfloat8): extended;
  39.  
  40. { These routines will convert a MicroSoft Binary Floating point
  41.   number to IEEE extended format.  The extended is large enough
  42.   to store any M'Soft single or double number, so no over/underflow
  43.   problems are encountered.  The Mantissa of an extended is large enough
  44.   to hold a BFloatx mantissa, so no truncation is required.
  45.  
  46.   The result can be returned to TP single and double variables and
  47.   TP will handle the conversion.  Note that Over/Underflow can occur
  48.   with these types. }
  49.  
  50. Function HexExt(ep:extended) : string;
  51.  
  52. { A routine to return the hex representation of an IEEE extended variable
  53.   Left in from debugging, you may find it useful }
  54.  
  55. Function ExtendedtoBfloat4(ep : extended; var b : bfloat4) : boolean;
  56. Function ExtendedtoBfloat8(ep : extended; var b : Bfloat8) : boolean;
  57.  
  58. { These routines are the reverse of the above, that is they convert
  59.   TP extended => M'Soft format.  You can use TP singles and doubles
  60.   as the first parameter and TP will do the conversion to extended
  61.   for you.
  62.  
  63.   The Function result returns True if the conversion was succesful,
  64.   and False if not (because of overflow).
  65.  
  66.   Since an extended can have an exponent that will not fit
  67.   in the M'Soft format Over/Underflow is handled in the following
  68.   manner:
  69.     Overflow:  Set the Bfloatx to 0 and return a False result.
  70.     Underflow: Set the BFloatx to 0 and return a True Result.
  71.  
  72.   No rounding is done on the mantissa.  It is simply truncated to
  73.   fit. }
  74.  
  75.  
  76. Function BFloat4toReal(b:bfloat4) : Real;
  77. Function BFloat8toReal(b:bfloat8) : Real;
  78.  
  79. { These routines will convert a MicroSoft Binary Floating point
  80.   number to Turbo real format.  The real is large enough
  81.   to store any M'Soft single or double Exponent, so no over/underflow
  82.   problems are encountered.  The Mantissa of an real is large enough
  83.   to hold a BFloat4 mantissa, so no truncation is required.  The
  84.   BFloat8 mantissa is truncated (from 7 bytes to 5 bytes) }
  85.  
  86. Function RealtoBFloat4(rp: real; var b:bfloat4) : Boolean;
  87. Function RealtoBFloat8(rp : real; var b:bfloat8) : Boolean;
  88.  
  89. { These routines do the reverse of the above.  No Over/Underflow can
  90.   occur, but truncation of the mantissa can occur
  91.   when converting Real to Bfloat4 (5 bytes to 3 bytes).
  92.  
  93.   The function always returns True, and is structured this way to
  94.   function similar to the IEEE formats }
  95.  
  96. implementation
  97. type
  98.   IEEEExtended = record
  99.      Case integer of
  100.      0 : (Mantissa : array[0..7] of byte;
  101.           Exponent : word);
  102.      1 : (e : extended);
  103.      end;
  104.  
  105.   TurboReal = record
  106.      Case integer of
  107.      0 : (Exponent : byte;
  108.           Mantissa : array[3..7] of byte);
  109.      1 : (r : real);
  110.      end;
  111.  
  112. Function HexExt(ep:extended) : string;
  113. var
  114.  e : IEEEExtended absolute ep;
  115.  i : integer;
  116.  s : string;
  117.  Function Hex(b:byte) : string;
  118.   const hc : array[0..15] of char = '0123456789ABCDEF';
  119.   begin
  120.   Hex := hc[b shr 4]+hc[b and 15];
  121.   end;
  122. begin
  123.   s := hex(hi(e.exponent))+hex(lo(e.exponent))+' ';
  124.   for i := 7 downto 0 do s := s+hex(e.mantissa[i]);
  125. HexExt := s;
  126. end;
  127.  
  128. Function NullMantissa(e : IEEEextended) : boolean;
  129. var
  130.  i : integer;
  131. begin
  132. NullMantissa := False;
  133. for i := 0 to 7 do if e.mantissa[i] <> 0 then exit;
  134. NullMantissa := true;
  135. end;
  136.  
  137. Procedure ShiftLeftMantissa(var e);
  138. { A routine to shift the 8 byte mantissa left one bit }
  139. inline(
  140. {0101} $F8/          {   CLC                        }
  141. {0102} $5F/          {   POP    DI                  }
  142. {0103} $07/          {   POP    ES                  }
  143. {0104} $B9/$04/$00/  {   MOV    CX,0004             }
  144. {0107} $26/$D1/$15/  {   RCL    Word Ptr ES:[DI],1  }
  145. {010A} $47/          {   INC    DI                  }
  146. {010B} $47/          {   INC    DI                  }
  147. {010C} $E2/$F9       {   LOOP   0107                }
  148. );
  149.  
  150. Procedure Normalize(var e : IEEEextended);
  151. { Normalize takes an extended and insures that the "i" bit is
  152.   set to 1 since M'Soft assumes a 1 is there. An extended has
  153.   a value of 0.0 if the mantissa is zero, so the first check.
  154.   The exponent also has to be kept from wrapping from 0 to $FFFF
  155.   so the "if e.exponent = 0" check.  If it gets this small
  156.   for the routines that call it, there would be underflow and 0
  157.   would be returned.
  158. }
  159. var
  160.  exp : word;
  161.  
  162. begin
  163. exp := e.exponent and $7FFF; { mask out sign }
  164. if NullMantissa(e) then
  165.    begin
  166.    E.exponent := 0;
  167.    exit
  168.    end;
  169. while e.mantissa[7] < 128 do
  170.    begin
  171.    ShiftLeftMantissa(e);
  172.    dec(exp);
  173.    if exp = 0 then exit;
  174.    end;
  175. e.exponent := (e.exponent and $8000) or exp;  { restore sign }
  176. end;
  177.  
  178. Function Bfloat8toExtended(d : Bfloat8) : extended;
  179. var
  180.   i : integer;
  181.   e : IEEEExtended;
  182. begin
  183.   fillchar(e,sizeof(e),0);
  184.   Bfloat8toExtended := 0.0;
  185.   if d.exponent = 0 then exit;
  186.   { if the bfloat exponent is 0 the mantissa is ignored and
  187.     the value reurned is 0.0 }
  188.   e.exponent := d.exponent - 129 + 16383;
  189.   { bfloat is biased by 129, extended by 16383
  190.     This creates the correct exponent }
  191.   if d.mantissa[7] > 127 then
  192.      { if the sign bit in bfloat is 1 then set the sign bit in the extended }
  193.      e.exponent := e.exponent or $8000;
  194.   move(d.Mantissa[1],e.mantissa[1],6);
  195.   e.mantissa[7] := $80 or (d.mantissa[7] and $7F);
  196.   { bfloat assumes 1.fffffff, so supply it for extended }
  197.   Bfloat8toExtended := e.e;
  198. end;
  199.  
  200. Function Bfloat4toExtended(d : bfloat4) : extended;
  201. var
  202.   i : integer;
  203.   e : IEEEExtended;
  204. begin
  205.   fillchar(e,sizeof(e),0);
  206.   Bfloat4toExtended := 0.0;
  207.   if d.exponent = 0 then exit;
  208.   e.exponent := integer(d.exponent - 129) + 16383;
  209.   if d.mantissa[7] > 127 then
  210.      e.exponent := e.exponent or $8000;
  211.   move(d.Mantissa[5],e.mantissa[5],2);
  212.   e.mantissa[7] := $80 or (d.mantissa[7] and $7F);
  213.   Bfloat4toExtended := e.e;
  214. end;
  215.  
  216. Function ExtendedtoBfloat8(ep : extended; var b : Bfloat8) : boolean;
  217. var
  218.   e : IEEEextended absolute ep;
  219.   exp : integer;
  220.   sign : byte;
  221. begin
  222. FillChar(b,Sizeof(b),0);
  223. ExtendedtoBfloat8 := true; { assume success }
  224. Normalize(e);
  225. if e.exponent = 0 then exit;
  226. sign := byte(e.exponent > 32767) shl 7;
  227. exp := (e.exponent and $7FFF) - 16383 + 129;
  228. if exp < 0 then exp := 0; { underflow }
  229. if exp > 255 then { overflow }
  230.    begin
  231.    ExtendedtoBfloat8 := false;
  232.    exit;
  233.    end;
  234. b.exponent := exp;
  235. move(e.mantissa[1],b.mantissa[1],7);
  236. b.mantissa[7] := (b.mantissa[7] and $7F) or sign;
  237. end;
  238.  
  239. Function ExtendedtoBfloat4(ep : extended; var b : Bfloat4) : boolean;
  240. var
  241.   e : IEEEextended absolute ep;
  242.   exp : integer;
  243.   sign : byte;
  244. begin
  245. FillChar(b,Sizeof(b),0);
  246. ExtendedtoBfloat4 := true; { assume success }
  247. Normalize(e);
  248. if e.exponent = 0 then exit;
  249. sign := byte(e.exponent > 32767) shl 7;
  250. exp := (e.exponent and $7FFF) - 16383 + 129;
  251. if exp < 0 then exp := 0; { underflow }
  252. if exp > 255 then { overflow }
  253.    begin
  254.    ExtendedtoBfloat4 := false;
  255.    exit;
  256.    end;
  257. b.exponent := exp;
  258. move(e.mantissa[5],b.mantissa[5],3);
  259. b.mantissa[7] := (b.mantissa[7] and $7F) or sign;
  260. end;
  261.  
  262. Function BFloat4toReal(b:bfloat4) : Real;
  263. var
  264.  r : TurboReal;
  265. begin
  266.   fillchar(r,sizeof(r),0);
  267.   r.exponent := b.exponent;
  268.   move(b.mantissa[5],r.mantissa[5],3);
  269.   Bfloat4toReal := r.r;
  270. end;
  271.  
  272. Function BFloat8toReal(b:bfloat8) : Real;
  273. var
  274.  r : TurboReal;
  275. begin
  276.   fillchar(r,sizeof(r),0);
  277.   r.exponent := b.exponent;
  278.   move(b.mantissa[3],r.mantissa[3],5);
  279.   Bfloat8toReal := r.r;
  280. end;
  281.  
  282. Function RealtoBFloat4(rp: real; var b:bfloat4) : Boolean;
  283. var
  284.  r : TurboReal absolute rp;
  285. begin
  286.   fillchar(b,sizeof(b),0);
  287.   b.exponent := r.exponent;
  288.   move(r.mantissa[5],b.mantissa[5],3);
  289.   RealtoBfloat4 := true;
  290. end;
  291.  
  292. Function RealtoBFloat8(rp : real; var b:bfloat8) : Boolean;
  293. var
  294.  r : TurboReal absolute rp;
  295. begin
  296.   fillchar(b,sizeof(b),0);
  297.   b.exponent := r.exponent;
  298.   move(r.mantissa[3],b.mantissa[3],5);
  299.   RealtoBfloat8 := true;
  300. end;
  301.  
  302. end.
  303.